home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / tl / tl-seq.el.z / tl-seq.el
Encoding:
Text File  |  1998-05-21  |  2.7 KB  |  110 lines
  1. ;;; tl-seq.el --- sequence functions
  2.  
  3. ;; Copyright (C) 1995,1996 Free Software Foundation, Inc.
  4.  
  5. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
  6. ;; Version:
  7. ;;    $Id: tl-seq.el,v 7.14 1996/08/28 11:50:41 morioka Exp $
  8. ;; Keywords: sequence
  9.  
  10. ;; This file is part of tl (Tiny Library).
  11.  
  12. ;; This program is free software; you can redistribute it and/or
  13. ;; modify it under the terms of the GNU General Public License as
  14. ;; published by the Free Software Foundation; either version 2, or (at
  15. ;; your option) any later version.
  16.  
  17. ;; This program is distributed in the hope that it will be useful, but
  18. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20. ;; General Public License for more details.
  21.  
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with This program; see the file COPYING.  If not, write to
  24. ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25. ;; Boston, MA 02111-1307, USA.
  26.  
  27. ;;; Code:
  28.  
  29. (require 'file-detect)
  30.  
  31. (cond ((file-installed-p "cl-seq.elc")
  32.        (require 'cl)
  33.        )
  34.       (t
  35.        (defun find-if (pred seq)
  36.      "Return the first element of sequence SEQ satisfying PRED.
  37. \[tl-seq.el]"
  38.      (let ((i 0)(len (length seq)) element)
  39.        (catch 'tag
  40.          (while (< i len)
  41.            (if (funcall pred (setq element (elt seq i)))
  42.            (throw 'tag element)
  43.          )
  44.            (setq i (+ i 1))
  45.            ))
  46.        ))
  47.        
  48.        (defun find (item seq)
  49.      "Return the first element which is found in sequence SEQ as item.
  50. \[tl-seq.el]"
  51.      (find-if (function
  52.            (lambda (elt)
  53.              (eq elt item)
  54.              ))
  55.           seq))
  56.        ))
  57.  
  58. (defun foldr (func a seq)
  59.   "Return (func (func (func (... (func a Sn) ...) S2) S1) S0)
  60. when func's argument is 2 and seq is a sequence whose
  61. elements = S0 S1 S2 ... Sn. [tl-seq.el]"
  62.   (let ((i (length seq)))
  63.     (while (> i 0)
  64.       (setq i (1- i))
  65.       (setq a (funcall func a (elt seq i)))
  66.       )
  67.     a))
  68.  
  69. (defun foldl (func a seq)
  70.   "Return (... (func (func (func a S0) S1) S2) ...)
  71. when func's argument is 2 and seq is a sequence whose
  72. elements = S0 S1 S2 .... [tl-seq.el]"
  73.   (let ((len (length seq))
  74.     (i 0))
  75.     (while (< i len)
  76.       (setq a (funcall func a (elt seq i)))
  77.       (setq i (1+ i))
  78.       )
  79.     a))
  80.  
  81. (defun pack-sequence (seq size)
  82.   (let ((len (length seq)) (p 0) obj
  83.     unit (i 0)
  84.     dest)
  85.     (while (< p len)
  86.       (setq obj (elt seq p))
  87.       (setq unit (cons obj unit))
  88.       (setq i (1+ i))
  89.       (if (= i size)
  90.       (progn
  91.         (setq dest (cons (reverse unit) dest))
  92.         (setq unit nil)
  93.         (setq i 0)
  94.         ))
  95.       (setq p (1+ p))
  96.       )
  97.     (if unit
  98.     (setq dest (cons (reverse unit) dest))
  99.       )
  100.     (reverse dest)
  101.     ))
  102.  
  103.  
  104. ;;; @ end
  105. ;;;
  106.  
  107. (provide 'tl-seq)
  108.  
  109. ;;; tl-seq.el ends here
  110.